VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "msdatgrd.ocx"
Object = "{B3FB64BF-91F9-11D7-A482-0008A14158BC}#2.22#0"; "ITGControls.ocx"
Begin VB.Form frmSecUserAccessLevel 
   BackColor       =   &H00F7D9C2&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   6885
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   14610
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6885
   ScaleWidth      =   14610
   ShowInTaskbar   =   0   'False
   Begin ITGControls.ITGTab SSTab1 
      Height          =   6885
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   14565
      _ExtentX        =   25691
      _ExtentY        =   12144
      TabCount        =   2
      TabCaption(0)   =   "               Main               "
      TabContCtrlCnt(0)=   5
      Tab(0)ContCtrlCap(1)=   "ComunionFrames2"
      Tab(0)ContCtrlCap(2)=   "txtRoleID"
      Tab(0)ContCtrlCap(3)=   "txtName"
      Tab(0)ContCtrlCap(4)=   "Timer1"
      Tab(0)ContCtrlCap(5)=   "lblInstruction"
      TabCaption(1)   =   "               List               "
      TabContCtrlCnt(1)=   1
      Tab(1)ContCtrlCap(1)=   "dtgList"
      TabTheme        =   2
      ActiveTabBackStartColor=   16250865
      ActiveTabBackEndColor=   16243138
      InActiveTabBackStartColor=   16243138
      InActiveTabBackEndColor=   16243138
      BeginProperty ActiveTabFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty InActiveTabFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      OuterBorderColor=   4210752
      TopLeftInnerBorderColor=   4210752
      BottomRightInnerBorderColor=   4210752
      DisabledTabBackColor=   16243138
      DisabledTabForeColor=   -2147483630
      Begin MSDataGridLib.DataGrid dtgList 
         Height          =   6570
         Left            =   -75000
         TabIndex        =   20
         Top             =   315
         Width           =   14565
         _ExtentX        =   25691
         _ExtentY        =   11589
         _Version        =   393216
         AllowUpdate     =   0   'False
         AllowArrows     =   -1  'True
         Appearance      =   0
         HeadLines       =   1
         RowHeight       =   15
         TabAction       =   2
         FormatLocked    =   -1  'True
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   "RoleID"
            Caption         =   "Role ID"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   1033
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   "Description"
            Caption         =   "Description"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   1033
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            AllowRowSizing  =   0   'False
            BeginProperty Column00 
               ColumnAllowSizing=   -1  'True
               Locked          =   -1  'True
               ColumnWidth     =   1590.236
            EndProperty
            BeginProperty Column01 
               Locked          =   -1  'True
               ColumnWidth     =   10440
            EndProperty
         EndProperty
      End
      Begin ITGControls.ComunionFrames ComunionFrames2 
         Height          =   5610
         Left            =   45
         Top             =   1200
         Width           =   14445
         _ExtentX        =   25479
         _ExtentY        =   9895
         FrameColor      =   4210752
         BackColor       =   16243138
         FillColor       =   16243138
         RoundedCorner   =   0   'False
         Caption         =   "Details"
         Alignment       =   0
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ThemeColor      =   5
         ColorFrom       =   16243138
         ColorTo         =   16250865
         Begin VB.CommandButton cmdRemoveAll 
            Caption         =   "<<"
            Height          =   570
            Left            =   4755
            TabIndex        =   16
            Top             =   4875
            Width           =   675
         End
         Begin VB.CommandButton cmdRemove 
            Caption         =   "<"
            Height          =   570
            Left            =   4755
            TabIndex        =   15
            Top             =   4320
            Width           =   675
         End
         Begin VB.CommandButton cmdSelect 
            Caption         =   ">"
            Height          =   570
            Left            =   4755
            TabIndex        =   14
            Top             =   3765
            Width           =   675
         End
         Begin VB.CommandButton cmdSelectAll 
            Caption         =   ">>"
            Height          =   570
            Left            =   4755
            TabIndex        =   12
            Top             =   3225
            Width           =   675
         End
         Begin VB.CheckBox chkFull 
            BackColor       =   &H00F7D9C2&
            Caption         =   "Full Access"
            Height          =   420
            Left            =   4650
            TabIndex        =   13
            Top             =   795
            Value           =   1  'Checked
            Width           =   945
         End
         Begin VB.Frame Frame1 
            BackColor       =   &H00F7D9C2&
            Height          =   2055
            Left            =   4545
            TabIndex        =   5
            Top             =   1140
            Width           =   1035
            Begin VB.CheckBox chkPrint 
               BackColor       =   &H00F7D9C2&
               Caption         =   "Print"
               Height          =   285
               Left            =   120
               TabIndex        =   11
               Top             =   1680
               Value           =   1  'Checked
               Width           =   825
            End
            Begin VB.CheckBox chkNew 
               BackColor       =   &H00F7D9C2&
               Caption         =   "New"
               Height          =   420
               Left            =   120
               TabIndex        =   10
               Top             =   120
               Value           =   1  'Checked
               Width           =   825
            End
            Begin VB.CheckBox chkEdit 
               BackColor       =   &H00F7D9C2&
               Caption         =   "Edit"
               Height          =   420
               Left            =   120
               TabIndex        =   9
               Top             =   420
               Value           =   1  'Checked
               Width           =   825
            End
            Begin VB.CheckBox chkDelete 
               BackColor       =   &H00F7D9C2&
               Caption         =   "Delete"
               Height          =   420
               Left            =   120
               TabIndex        =   8
               Top             =   720
               Value           =   1  'Checked
               Width           =   765
            End
            Begin VB.CheckBox chkPost 
               BackColor       =   &H00F7D9C2&
               Caption         =   "Post"
               Height          =   420
               Left            =   120
               TabIndex        =   7
               Top             =   1020
               Value           =   1  'Checked
               Width           =   765
            End
            Begin VB.CheckBox chkCancel 
               BackColor       =   &H00F7D9C2&
               Caption         =   "Cancel"
               Height          =   420
               Left            =   120
               TabIndex        =   6
               Top             =   1320
               Value           =   1  'Checked
               Width           =   825
            End
         End
         Begin MSComctlLib.ListView lvwAccessLevel 
            Height          =   4650
            Left            =   5685
            TabIndex        =   17
            Top             =   765
            Width           =   8670
            _ExtentX        =   15293
            _ExtentY        =   8202
            View            =   3
            LabelEdit       =   1
            Sorted          =   -1  'True
            LabelWrap       =   -1  'True
            HideSelection   =   -1  'True
            FullRowSelect   =   -1  'True
            GridLines       =   -1  'True
            _Version        =   393217
            ForeColor       =   -2147483640
            BackColor       =   -2147483643
            BorderStyle     =   1
            Appearance      =   1
            BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "Tahoma"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            NumItems        =   9
            BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               Text            =   "Module"
               Object.Width           =   0
            EndProperty
            BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   1
               Text            =   "Description"
               Object.Width           =   7408
            EndProperty
            BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   2
               Text            =   "Access Level"
               Object.Width           =   0
            EndProperty
            BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   3
               Text            =   "New"
               Object.Width           =   1235
            EndProperty
            BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   4
               Text            =   "Edit"
               Object.Width           =   1235
            EndProperty
            BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   5
               Text            =   "Delete"
               Object.Width           =   1235
            EndProperty
            BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   6
               Text            =   "Post"
               Object.Width           =   1235
            EndProperty
            BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   7
               Text            =   "Cancel"
               Object.Width           =   1235
            EndProperty
            BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   8
               Text            =   "Print"
               Object.Width           =   1235
            EndProperty
         End
         Begin MSComctlLib.ListView lvwModule 
            Height          =   4695
            Left            =   90
            TabIndex        =   18
            Top             =   765
            Width           =   4350
            _ExtentX        =   7673
            _ExtentY        =   8281
            View            =   3
            LabelEdit       =   1
            Sorted          =   -1  'True
            LabelWrap       =   -1  'True
            HideSelection   =   -1  'True
            FullRowSelect   =   -1  'True
            GridLines       =   -1  'True
            _Version        =   393217
            ForeColor       =   -2147483640
            BackColor       =   -2147483643
            BorderStyle     =   1
            Appearance      =   1
            BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "Tahoma"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            NumItems        =   2
            BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               Text            =   "Module"
               Object.Width           =   0
            EndProperty
            BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   1
               Text            =   "Description"
               Object.Width           =   7232
            EndProperty
         End
         Begin VB.Label lblEditAccessLevel 
            Alignment       =   2  'Center
            BackColor       =   &H80000008&
            Caption         =   "Edit Access Level"
            BeginProperty Font 
               Name            =   "Tahoma"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00C0FFFF&
            Height          =   285
            Left            =   5715
            TabIndex        =   19
            Top             =   495
            Width           =   8625
         End
      End
      Begin ITGControls.ITGTextBox txtRoleID 
         Height          =   285
         Left            =   270
         TabIndex        =   4
         Top             =   615
         Width           =   2565
         _ExtentX        =   4313
         _ExtentY        =   503
         SendKeysTab     =   -1  'True
         LabelBackColor  =   16243138
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         AllCaps         =   -1  'True
         Mandatory       =   -1  'True
         Label           =   "Role ID"
         BeginProperty LabelFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         LabelWidth      =   1250
         TextBoxWidth    =   1255
      End
      Begin ITGControls.ITGTextBox txtName 
         Height          =   285
         Left            =   2895
         TabIndex        =   2
         Top             =   630
         Width           =   4620
         _ExtentX        =   8043
         _ExtentY        =   503
         SendKeysTab     =   -1  'True
         BackColor       =   14737632
         LabelBackColor  =   16243138
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Label           =   "ITGtext"
         BeginProperty LabelFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         LabelWidth      =   0
         TextBoxWidth    =   4560
         Enabled         =   0   'False
      End
      Begin VB.Timer Timer1 
         Interval        =   300
         Left            =   7200
         Top             =   240
      End
      Begin VB.Label lblInstruction 
         BackStyle       =   0  'Transparent
         Caption         =   $"frmSecUserAccessLevel.frx":0000
         Height          =   495
         Left            =   7830
         TabIndex        =   3
         Top             =   540
         Visible         =   0   'False
         Width           =   6495
      End
   End
   Begin MSComctlLib.StatusBar sbRS 
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   1
      Top             =   6630
      Width           =   14610
      _ExtentX        =   25770
      _ExtentY        =   450
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   3528
            MinWidth        =   3528
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmSecUserAccessLevel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'IT Group Inc. 2005.09.23

Option Explicit

'Object variables





'Recordset variables
Private WithEvents rsHeader As ADODB.Recordset
Attribute rsHeader.VB_VarHelpID = -1
Private rsModule As ADODB.Recordset
Private rsAccess As ADODB.Recordset

'Form mode enumeration
Enum eSecAccessLevel
    Normal
    AddNewEdit
    Find
End Enum
Public Mode As eSecAccessLevel

'Other declarations
Public dtgName As String
Public sBit As String
Private vBM As Variant 'Recordset bookmark variable

'Security Acess Level variables
Public lACNew As Boolean
Public lACEdit As Boolean
Public lACDelete As Boolean
Public lACPost As Boolean
Public lACCancel As Boolean
Public lACPrint As Boolean

Private AccessLevelNew, AccessLevelEdit, AccessLevelDelete, _
    AccessLevelPost, AccessLevelCancel, AccessLevelPrint As String

Private Sub chkFull_Click()
    If Mode <> AddNewEdit Then Exit Sub
    If chkFull.Value = Checked Then
        chkNew.Value = Checked
        chkEdit.Value = Checked
        chkDelete.Value = Checked
        chkPost.Value = Checked
        chkCancel.Value = Checked
        chkPrint.Value = Checked
        Frame1.Enabled = False
    Else
        Frame1.Enabled = True
    End If
End Sub

Private Sub dtgList_HeadClick(ByVal ColIndex As Integer)
    SortGrid dtgList, ColIndex, rsHeader
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Dim iKey As Integer
    iKey = ToolbarIndex(KeyCode, Shift)
    If iKey <> 0 Then
        If ITGLedgerMain.tbrMain.Buttons(iKey).Enabled = True Then
            ToolbarFunction iKey
        End If
    End If
End Sub

'Set Your Object
Private Sub Form_Load()

    Set FrmName = Me
    FormSetup
    
    AcessBit Me, GetValueFrTable("AccessLevel", "SEC_ACCESSLEVEL", "RoleID = '" & SecUserRole & "' AND [Module] = 'SC04'")
  
    Set rsHeader = New ADODB.Recordset
    Set rsModule = New ADODB.Recordset
    Set rsAccess = New ADODB.Recordset
    

    FormLocking True
    BitEnabled ITGLedgerMain, Me, ITGLedgerMain.tbrMain, , , , , , , , , , True, , , True
    BitVisible ITGLedgerMain.tbrMain
    ITGLedgerMain.tbrMain.Buttons("btnFind").ButtonMenus("btnFindP").Enabled = True

    Mode = Find
    txtRoleID.Locked = False
    
End Sub

'Activate your Toolbar Mode
Private Sub Form_Activate()
    TBBitReload
End Sub

'Release your Object
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
    If Mode = AddNewEdit Then
        MsgBox "Unable to close. You are in Add/New/Edit mode." & vbCr & _
            " Must Save or Undo", vbCritical, Me.Caption
        Cancel = True
        Exit Sub
    End If
    
    CloseMenuTab ITGLedgerMain

    BitEnabled ITGLedgerMain, Me, ITGLedgerMain.tbrMain, , , , , , , , , , True
    BitVisible ITGLedgerMain.tbrMain
    ITGLedgerMain.tbrMain.Buttons("btnFind").ButtonMenus("btnFindP").Enabled = False

    
    
    
    
    Set rsHeader = Nothing
    Set rsAccess = Nothing
    Set rsModule = Nothing
    
    Set frmSecUserAccessLevel = Nothing

    lCloseWindow = True
    
'    'oForm(Me.Tag).Mode = 1
'    'oForm(Me.Tag).Tag = Me.Tag
End Sub

'Add new record to the recordset
Public Sub TBNew()

    '**********

End Sub

'Undo all changes to the recordset
Public Sub TBUndoAll()
On Error GoTo ErrorHandler


    lblEditAccessLevel.Visible = False
    cmdSelectAll.Caption = ">>"
    chkFull.Value = Checked
    chkFull_Click
    
    Mode = Normal
    
    If rsHeader.RecordCount <> 0 Then rsHeader.Bookmark = vBM
    
    Set FrmName = Me
    FormLocking True
    
    If rsHeader.RecordCount <> 0 Then
        BitEnabled ITGLedgerMain, Me, ITGLedgerMain.tbrMain, , lACEdit, , , , , , , , True, True, , True
    Else
        RSZero
        Mode = Find
    End If
    
    sbRS.Panels(2) = ""
    
    txtRoleID_Change
    
ErrorHandler:
    If err.Number = -2147217885 Then
        Resume Next
    ElseIf err.Number = -2147217842 Then 'Operation was cancelled. (Error returned by ITGDateBox)
        TBUndoAll
    End If

End Sub

'Undo changes on the current record
Public Sub TBUndoCurrent()
On Error GoTo ErrorHandler

ErrorHandler:
    If err.Number = -2147217885 Then
        Resume Next
    ElseIf err.Number = -2147217842 Then 'Operation was cancelled. (Error returned by ITGDateBox)
        TBUndoCurrent
    End If

End Sub

'Save all changes
Public Sub TBSave()

    lblEditAccessLevel.Visible = False
    cmdSelectAll.Caption = ">>"
    chkFull.Value = Checked
    chkFull_Click
    
    sSQL = "DELETE SEC_ACCESSLEVEL WHERE RoleID = '" & Trim$(txtRoleID) & "' AND cCompanyID = '" & COID & "'"
    cn.Execute sSQL
    
    If lvwAccessLevel.ListItems.Count <> 0 Then
        For i = 1 To lvwAccessLevel.ListItems.Count
            sSQL = "'" & COID & "', '" & Trim$(txtRoleID) & "',"
            sSQL = sSQL & "'" & lvwAccessLevel.ListItems(i) & "',"
            sSQL = sSQL & "'" & lvwAccessLevel.ListItems(i).SubItems(2) & "'"
            sSQL = "INSERT INTO SEC_ACCESSLEVEL VALUES (" & sSQL & ")"
            cn.Execute sSQL
        Next i
    End If
               
    
    MsgBox "Access Level of User Role " & Trim$(txtName) & " saved.", vbInformation, "ComUnion"

    Set FrmName = Me
    FormLocking True
    BitEnabled ITGLedgerMain, Me, ITGLedgerMain.tbrMain, , lACEdit, , , , , , , , True, True, , True
    Mode = Normal
    sbRS.Panels(2) = ""
    
    'Audit trail
    UpdateLogFile "Sec - User Access Access", Trim(txtRoleID), IIf(lBoolean, "Inserted", "Updated")

End Sub

'Sets the form & recorset to add/edit mode
Public Sub TBEdit()
    Mode = AddNewEdit
    BitEnabled ITGLedgerMain, Me, ITGLedgerMain.tbrMain, , , , , , , , True, True, , , , True
    Set FrmName = Me
    FormLocking False
    txtRoleID.Locked = True
    vBM = rsHeader.Bookmark
    chkFull.Value = Checked
    chkFull_Click
End Sub

'Delete record
Public Sub TBDelete()
On Error GoTo ErrorHandler

ErrorHandler:
    If err.Number = -2147217885 Then
        Resume Next
    End If

End Sub

'Search using the frmITGSearch
Public Sub TBFind()
    Mode = Normal
    txtRoleID.Locked = True
    frmITGSearch.Show 'vbModal
End Sub

'Search using the recordset primary key
Public Sub TBFindPrimary()
        'Find
        If Mode = Find Then
        
            FormWaitShow App.Path & "\Transmit.avi", "Loading data . . ."
            
            Set rsHeader = Nothing
            Set rsHeader = New ADODB.Recordset

            If Trim(txtRoleID) = "" Then
                OpenRecordset rsHeader, "*", "SEC_ROLE", , True
            Else
                OpenRecordset rsHeader, "*", "SEC_ROLE", "WHERE RoleID LIKE '" & Trim(txtRoleID) & "%'", True
            End If

            Set FrmName = Me
            FormLocking True

            If rsHeader.RecordCount = 0 Then
                FormWaitHide
                MsgBox "No matching record/s found.", vbInformation, "ComUnion Search"
                rsHeader.Close
                BitEnabled ITGLedgerMain, Me, ITGLedgerMain.tbrMain, , , , , , , , , , True, , , True
                txtRoleID.Locked = False
                txtRoleID.SetFocus
                Exit Sub
            End If

            SetDataSource
            SetDataField

            txtRoleID.BackColor = &HE0FFFF
            Mode = Normal

            BitEnabled ITGLedgerMain, Me, ITGLedgerMain.tbrMain, , lACEdit, , , , , , , , True, True, , True

            FormWaitHide
            
            txtRoleID_Change
    Else
    RSZero
    Mode = Find
    End If
End Sub

'Reload menu buttons (do not delete this sub)
Public Sub TBBitReload()
    BitVisible ITGLedgerMain.tbrMain
    ITGLedgerMain.tbrMain.Buttons("btnFind").ButtonMenus("btnFindP").Enabled = True
    BitReload ITGLedgerMain, Me, ITGLedgerMain.tbrMain, sBit
    Set FrmName = Me
End Sub

'Close active window
Public Sub TBCloseWindow()
    Unload Me
End Sub

'Move first
Public Sub TBFirstRec()
    If rsHeader.State <> adStateOpen Then Exit Sub
    MoveFirst rsHeader
    
End Sub

'Move previuos
Public Sub TBPrevRec()
    If rsHeader.State <> adStateOpen Then Exit Sub
    MovePrevious rsHeader

End Sub

'Move next
Public Sub TBNextRec()
    If rsHeader.State <> adStateOpen Then Exit Sub
    MoveNext rsHeader

End Sub

'Move last
Public Sub TBLastRec()
    If rsHeader.State <> adStateOpen Then Exit Sub
    MoveLast rsHeader
    
End Sub

'Add new line to the detail recordset
Public Sub TBNewLine()
    'not available
End Sub

'Delete line in the detail recordset
Public Sub TBDeleteLine()
    'not available
End Sub

'Undo All
Public Sub TBUndoLineAll()
On Error GoTo ErrorHandler

    MsgBox "Unavailable on " & Me.Name

ErrorHandler:
    If err.Number = -2147217885 Then
        Resume Next
    End If

End Sub

'Undo current line
Public Sub TBUndoLineCurrent()
    MsgBox "Unavailable on " & Me.Name
End Sub

'Post current record
Public Sub TBPostRecord()
    MsgBox "Unavailable on " & Me.Name
End Sub

'Cancel current record
Public Sub TBCancelRecord()
    MsgBox "Unavailable on " & Me.Name
End Sub

'Print
Public Sub TBPrintRecord()
    MsgBox "Unavailable on " & Me.Name
End Sub

'Sets the data source of the controls
Sub SetDataSource()
    Set FrmName = Me
    BindControls rsHeader
    Set dtgList.DataSource = rsHeader
   
End Sub

'Sets the data field for every bounded controls
Sub SetDataField()
    With rsHeader
        txtRoleID.DataField = !RoleID
    End With
End Sub

Private Sub lvwAccessLevel_DblClick()
    If Mode <> AddNewEdit Then Exit Sub
    If lvwAccessLevel.ListItems.Count < 1 Then Exit Sub
    If lvwAccessLevel.SelectedItem.Selected = False Then Exit Sub
    BitToCheckBox lvwAccessLevel.SelectedItem.ListSubItems(2).Text
    lblEditAccessLevel.Caption = "Edit Access Level [" & Replace(lvwAccessLevel.SelectedItem.ListSubItems(1).Text, "&", "&&") & "]"
    lblEditAccessLevel.Visible = True
    lblEditAccessLevel.Visible = True
    cmdSelectAll.Caption = "&OK"
End Sub

Private Sub lvwAccessLevel_ItemClick(ByVal Item As MSComctlLib.ListItem)
    If Mode <> AddNewEdit Then Exit Sub
    If cmdSelectAll.Caption <> "&OK" Then Exit Sub
    If lvwAccessLevel.ListItems.Count < 1 Then Exit Sub
    If lvwAccessLevel.SelectedItem.Selected = False Then Exit Sub
    BitToCheckBox lvwAccessLevel.SelectedItem.ListSubItems(2).Text
    lblEditAccessLevel.Caption = "Edit Access Level [" & Replace(lvwAccessLevel.SelectedItem.ListSubItems(1).Text, "&", "&&") & "]"
    lblEditAccessLevel.Visible = True
    lblEditAccessLevel.Visible = True
    cmdSelectAll.Caption = "&OK"
End Sub

Private Sub rsHeader_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error GoTo ErrorHandler

    If Not (rsHeader.EOF) Or Not (rsHeader.BOF) Then
        'Status bar setup
        sbRS.Panels(1) = "Record: " & IIf((rsHeader.AbsolutePosition = -2), "0", rsHeader.AbsolutePosition) & "/" & rsHeader.RecordCount

        If rsHeader.Status <> adRecNew Then
            txtRoleID.Locked = True
        Else
            txtRoleID.Locked = False
        End If

        If Mode = AddNewEdit Then
            Select Case rsHeader.Status
                Case adRecNew
                    sbRS.Panels(2) = "New"
                Case adRecModified
                    sbRS.Panels(2) = "Modified"
                Case Else
                    sbRS.Panels(2) = ""
            End Select
        Else
            sbRS.Panels(2) = ""
        End If
        
        GetChild
    Else
        sbRS.Panels(1) = "Record: 0/0"
        sbRS.Panels(2) = ""
        txtRoleID.Locked = False
    End If

ErrorHandler:
    'Err.Number -2147217885
    'Description - Row handle referred to a deleted row or a row marked for deletion.
    If err.Number = -2147217885 Then
        Resume Next
    End If

End Sub

Private Sub Timer1_Timer()
    If Mode = AddNewEdit Then
        lblInstruction.Visible = True
        SSTab1.TabEnabled(1) = False
        lvwAccessLevel.ToolTipText = "Double click record to edit access level."
    Else
        lblInstruction.Visible = False
        SSTab1.TabEnabled(1) = True
        lvwAccessLevel.ToolTipText = ""
    End If
    
    If Mode <> Find Then Exit Sub
    If txtRoleID.BackColor = &HE0FFFF Then
        txtRoleID.BackColor = &HE0E0E0
        Exit Sub
    End If
    If txtRoleID.BackColor <> &HE0FFFF Then
        txtRoleID.BackColor = &HE0FFFF
        Exit Sub
    End If
End Sub

Private Sub txtRoleID_Change()
Dim strTemp As String

    If Mode = Find Then Exit Sub

    txtName = ""
    txtName = GetValueFrTable("Description", "SEC_ROLE", "RoleID = '" & Trim(txtRoleID) & "'", True)

    lvwModule.ListItems.Clear
    lvwAccessLevel.ListItems.Clear

    If txtName = "" Then Exit Sub
    
    strTemp = ""

    sSQL = "SELECT * FROM SEC_ACCESSLEVEL A INNER JOIN SEC_MODULE B ON A.[Module] " & _
           "= B.[Module] WHERE A.RoleID = '" & Trim(txtRoleID) & "' AND A.cCompanyID = '" & COID & "'"

    rsAccess.Open sSQL, cn, adOpenKeyset
    If rsAccess.RecordCount <> 0 Then
        Do Until rsAccess.EOF
            Set itmX = Me.lvwAccessLevel.ListItems.Add(, , Trim(rsAccess!Module))
                itmX.SubItems(1) = Trim(rsAccess!Description)
                itmX.SubItems(2) = Trim(rsAccess!AccessLevel)
                BitToWords Trim(rsAccess!AccessLevel)
                itmX.SubItems(3) = AccessLevelNew
                itmX.SubItems(4) = AccessLevelEdit
                itmX.SubItems(5) = AccessLevelDelete
                itmX.SubItems(6) = AccessLevelPost
                itmX.SubItems(7) = AccessLevelCancel
                itmX.SubItems(8) = AccessLevelPrint
                strTemp = strTemp & "'" & Trim(rsAccess!Module) & "',"
        rsAccess.MoveNext
        Loop
            strTemp = Left(strTemp, Len(strTemp) - 1)
    End If
    rsAccess.Close

    sSQL = "SELECT * FROM SEC_MODULE"
    If strTemp <> "" Then sSQL = sSQL & " WHERE Module NOT IN (" & strTemp & ")"
    rsModule.Open sSQL, cn, adOpenKeyset
    Do Until rsModule.EOF
        Set itmX = Me.lvwModule.ListItems.Add(, , Trim(rsModule!Module))
            itmX.SubItems(1) = Trim(rsModule!Description)
    rsModule.MoveNext
    Loop
    rsModule.Close

End Sub

'Check if all mandatory fields are complete
Function MandatoryOK() As Boolean
    MandatoryOK = True
End Function

'Filter detail recordset to header's primary
Private Sub GetChild()
    'not available
End Sub

'Sets the form if record number is zero
Private Sub RSZero()
    sbRS.Panels(1) = "Record: 0/0"
    sbRS.Panels(2) = ""
    
    Set FrmName = Me
    UnbindControls
    TextClearing
    FormLocking True
    
    If rsHeader.State = adStateOpen Then rsHeader.Close
    
    BitEnabled ITGLedgerMain, Me, ITGLedgerMain.tbrMain, , , , , , , , , , True, , , True
    
    txtRoleID.Locked = False
    txtRoleID.SetFocus
    
    Mode = Find
    
End Sub



Private Sub cmdRemove_Click()
    If cmdSelectAll.Caption = "&OK" Then Exit Sub
    If lvwAccessLevel.ListItems.Count = 0 Then Exit Sub
    If lvwAccessLevel.SelectedItem.Selected Then
        Set itmX = lvwModule.ListItems.Add(, , Trim$(lvwAccessLevel.SelectedItem))
        itmX.SubItems(1) = Trim$(lvwAccessLevel.SelectedItem.SubItems(1))
        lvwAccessLevel.ListItems.Remove lvwAccessLevel.SelectedItem.Index
    End If
End Sub

Private Sub cmdRemoveAll_Click()
    If cmdSelectAll.Caption = "&OK" Then Exit Sub
    If lvwAccessLevel.ListItems.Count = 0 Then Exit Sub
    For i = 1 To lvwAccessLevel.ListItems.Count
        Set itmX = lvwModule.ListItems.Add(, , Trim$(lvwAccessLevel.ListItems(i)))
        itmX.SubItems(1) = Trim$(lvwAccessLevel.ListItems(i).SubItems(1))
    Next i
    lvwAccessLevel.ListItems.Clear
End Sub

Private Sub cmdSelect_Click()
    If cmdSelectAll.Caption = "&OK" Then Exit Sub
    If lvwModule.ListItems.Count = 0 Then Exit Sub

    If lvwModule.SelectedItem.Selected Then
        Set itmX = lvwAccessLevel.ListItems.Add(, , Trim$(lvwModule.SelectedItem))
        itmX.SubItems(1) = Trim$(lvwModule.SelectedItem.SubItems(1))
        itmX.SubItems(2) = AccessLevel
        itmX.SubItems(3) = AccessLevelNew
        itmX.SubItems(4) = AccessLevelEdit
        itmX.SubItems(5) = AccessLevelDelete
        itmX.SubItems(6) = AccessLevelPost
        itmX.SubItems(7) = AccessLevelCancel
        itmX.SubItems(8) = AccessLevelPrint
        lvwModule.ListItems.Remove lvwModule.SelectedItem.Index
    End If

End Sub

Private Sub cmdSelectAll_Click()
    If cmdSelectAll.Caption = "&OK" Then
        lvwAccessLevel.SelectedItem.SubItems(2) = AccessLevel
        lvwAccessLevel.SelectedItem.SubItems(3) = AccessLevelNew
        lvwAccessLevel.SelectedItem.SubItems(4) = AccessLevelEdit
        lvwAccessLevel.SelectedItem.SubItems(5) = AccessLevelDelete
        lvwAccessLevel.SelectedItem.SubItems(6) = AccessLevelPost
        lvwAccessLevel.SelectedItem.SubItems(7) = AccessLevelCancel
        lvwAccessLevel.SelectedItem.SubItems(8) = AccessLevelPrint
        lblEditAccessLevel.Visible = False
        cmdSelectAll.Caption = ">>"
    Else
        If lvwModule.ListItems.Count = 0 Then Exit Sub
        
        For i = 1 To lvwModule.ListItems.Count
            Set itmX = lvwAccessLevel.ListItems.Add(, , Trim$(lvwModule.ListItems(i)))
            itmX.SubItems(1) = Trim$(lvwModule.ListItems(i).SubItems(1))
            itmX.SubItems(2) = AccessLevel
            itmX.SubItems(3) = AccessLevelNew
            itmX.SubItems(4) = AccessLevelEdit
            itmX.SubItems(5) = AccessLevelDelete
            itmX.SubItems(6) = AccessLevelPost
            itmX.SubItems(7) = AccessLevelCancel
            itmX.SubItems(8) = AccessLevelPrint
        Next i
        lvwModule.ListItems.Clear
    End If
End Sub

Function AccessLevel() As String
    AccessLevel = Empty
    If chkFull.Value = Checked Then
        AccessLevel = "F"
        AccessLevelNew = "Yes"
        AccessLevelEdit = "Yes"
        AccessLevelDelete = "Yes"
        AccessLevelPost = "Yes"
        AccessLevelCancel = "Yes"
        AccessLevelPrint = "Yes"
    Else
        'New
        If chkNew.Value = Checked Then
            AccessLevel = AccessLevel & "1"
            AccessLevelNew = "Yes"
        Else
            AccessLevel = AccessLevel & "0"
            AccessLevelNew = "No"
        End If
        'Edit
        If chkEdit.Value = Checked Then
            AccessLevel = AccessLevel & "1"
            AccessLevelEdit = "Yes"
        Else
            AccessLevel = AccessLevel & "0"
            AccessLevelEdit = "No"
        End If
        'Delete
        If chkDelete.Value = Checked Then
            AccessLevel = AccessLevel & "1"
            AccessLevelDelete = "Yes"
        Else
            AccessLevel = AccessLevel & "0"
            AccessLevelDelete = "No"
        End If
        'Post/Approve
        If chkPost.Value = Checked Then
            AccessLevel = AccessLevel & "1"
            AccessLevelPost = "Yes"
        Else
            AccessLevel = AccessLevel & "0"
            AccessLevelPost = "No"
        End If
        'Cancel
        If chkCancel.Value = Checked Then
            AccessLevel = AccessLevel & "1"
            AccessLevelCancel = "Yes"
        Else
            AccessLevel = AccessLevel & "0"
            AccessLevelCancel = "No"
        End If
        'Print
        If chkPrint.Value = Checked Then
            AccessLevel = AccessLevel & "1"
            AccessLevelPrint = "Yes"
        Else
            AccessLevel = AccessLevel & "0"
            AccessLevelPrint = "No"
        End If
        If AccessLevel = "111111" Then AccessLevel = "F"
    End If
End Function

Sub BitToWords(BitCode As String)
    If BitCode = "F" Then
        AccessLevelNew = "Yes"
        AccessLevelEdit = "Yes"
        AccessLevelDelete = "Yes"
        AccessLevelPost = "Yes"
        AccessLevelCancel = "Yes"
        AccessLevelPrint = "Yes"
    Else
        AccessLevelNew = IIf(Mid(BitCode, 1, 1) = "1", "Yes", "No")
        AccessLevelEdit = IIf(Mid(BitCode, 2, 1) = "1", "Yes", "No")
        AccessLevelDelete = IIf(Mid(BitCode, 3, 1) = "1", "Yes", "No")
        AccessLevelPost = IIf(Mid(BitCode, 4, 1) = "1", "Yes", "No")
        AccessLevelCancel = IIf(Mid(BitCode, 5, 1) = "1", "Yes", "No")
        AccessLevelPrint = IIf(Mid(BitCode, 6, 1) = "1", "Yes", "No")
    End If
End Sub

Sub BitToCheckBox(BitCode As String)
    If BitCode = "F" Then
        chkFull.Value = Checked
        chkNew.Value = Checked
        chkEdit.Value = Checked
        chkDelete.Value = Checked
        chkPost.Value = Checked
        chkCancel.Value = Checked
        chkPrint.Value = Checked
    Else
        chkFull.Value = Unchecked
        chkNew.Value = IIf(Mid(BitCode, 1, 1) = "1", Checked, Unchecked)
        chkEdit.Value = IIf(Mid(BitCode, 2, 1) = "1", Checked, Unchecked)
        chkDelete.Value = IIf(Mid(BitCode, 3, 1) = "1", Checked, Unchecked)
        chkPost.Value = IIf(Mid(BitCode, 4, 1) = "1", Checked, Unchecked)
        chkCancel.Value = IIf(Mid(BitCode, 5, 1) = "1", Checked, Unchecked)
        chkPrint.Value = IIf(Mid(BitCode, 6, 1) = "1", Checked, Unchecked)
    End If
End Sub

